home *** CD-ROM | disk | FTP | other *** search
/ Sun Solutions 1997 April to September / Sun Solutions CD - APR '97 - SEP '97 (704-3778-12 Rev. H)(Sun Microsystems, Inc.)(1997).iso / products / bin / httpd / Solaris_2 / http-query-setup.tcl < prev    next >
Text File  |  1995-12-04  |  3KB  |  158 lines
  1. #arguments are passed on command line. '&' separates assignments
  2. #assignments have the form name=value
  3. #'+'s are spaces and spaces separating words on command line are
  4. #actually part of the word
  5. #In our environment, if argument starts with /, then pathname
  6. #components are assignments
  7.  
  8. # global variable artype(i) defines what type ar(i) should be.  Currently,
  9. # list or not.
  10.  
  11. proc subhex {v} {
  12. # multiline crap I need to parse
  13. # ONE%0D%0ATWO%0D%0ATHREE%0D%0A
  14.     set nv $v
  15.     regsub -all {%0D%0A} $v "\n" v
  16.     while {[regexp {%[0-9A-F][0-9A-F]} $v blah]} {
  17.     scan $blah "%%%x" cv
  18.     if {[ctype char $cv]=="&"} {
  19.         regsub -all $blah $v \\& nv
  20.     } else {
  21.         regsub -all $blah $v [ctype char $cv] nv
  22.     }
  23.     set v $nv
  24.     }
  25.     return $v
  26. }
  27. proc http_proc_args {arg} {
  28.     global ar artype
  29.     upvar $arg argv
  30.     set bigarg ""
  31.     #join words with +'s
  32.  
  33.     if [llength $argv]==2 {
  34.     set bigarg [split [lindex $argv 1] &]
  35.     set path [lindex $argv 0]
  36.     set args [split [crange $path 1 end] /]
  37.     } else {
  38.     set a0 [lindex $argv 0]
  39.     if {[lindex $a0 0]=="/"} {
  40.         set bigarg {}
  41.         set args [split [lrange $a0 1 end] /]
  42.     } else {
  43.         set bigarg [split $a0 &]
  44.         set args {}
  45.     }
  46.     }
  47.     foreach arg [concat $bigarg $args] {
  48.     if [regexp {(.*)=(.*)} $arg foo name value] {
  49.         set name [subhex $name]
  50.         if ![info exists argcount($name)] {
  51.         set argcount($name) 1
  52.         } else {
  53.         incr argcount($name)
  54.         }
  55.     }
  56.     }
  57.         
  58.     #split assignments on the '&' 
  59.     foreach arg [concat $bigarg $args] {
  60.     if [regexp {(.*)=(.*)} $arg foo name value] {
  61.         regsub -all {\+} $value { } newval
  62.         set name [subhex $name]
  63.         set val [subhex $newval]
  64.         if ![info exists ar($name)] {
  65.         if [info exists artype($name)] {
  66.             if {$artype($name)=="list"} {
  67.             if {$val!=""} {
  68.                 set ar($name) [list $val]
  69.             } else {
  70.                 set ar($name) {}
  71.             }
  72.             } else {
  73.             set ar($name) $val
  74.             }
  75.         } else {
  76.             set ar($name) $val
  77.         }
  78.         } else {
  79.         # multiple selection
  80.         lappend ar($name) $val
  81.         }
  82.     }
  83.     }
  84. }
  85.  
  86. #makes URL extended pathname to encode current state
  87. proc pkg_attrs {var attrs} {
  88.     upvar $var ar
  89.     set al ""
  90.     foreach i $attrs {
  91.         if [info exists ar($i)] {
  92. #            regsub { } $ar($i) {+} att
  93.             set al "$al/$i=$att"
  94.         }
  95.     }
  96.     return $al
  97. }
  98.  
  99. proc http_proc_cgi_args {} {
  100.     global ar artype
  101.     global env
  102.     set bigarg ""
  103.     #join words with +'s
  104.     if [info exists env(PATH_INFO)] {
  105.     set args [split [crange $env(PATH_INFO) 1 end] /]
  106.     } else {
  107.     set args {}
  108.     }
  109.     if [info exists env(QUERY_STRING)] {
  110.     set bigarg [split $env(QUERY_STRING) &]
  111.     } else {
  112.     set bigarg {}
  113.     }
  114.  
  115.     foreach arg [concat $bigarg $args] {
  116.     if [regexp {(.*)=(.*)} $arg foo name value] {
  117.         set name [subhex $name]
  118.         if ![info exists argcount($name)] {
  119.         set argcount($name) 1
  120.         } else {
  121.         incr argcount($name)
  122.         }
  123.     }
  124.     }
  125.         
  126.     #split assignments on the '&' 
  127.     foreach arg [concat $bigarg $args] {
  128.     if [regexp {(.*)=(.*)} $arg foo name value] {
  129.         regsub -all {\+} $value { } newval
  130.         set name [subhex $name]
  131.         set val [subhex $newval]
  132.         if ![info exists ar($name)] {
  133.         if [info exists artype($name)] {
  134.             if {$artype($name)=="list"} {
  135.             if {$val!=""} {
  136.                 set ar($name) [list $val]
  137.             } else {
  138.                 set ar($name) {}
  139.             }
  140.             } else {
  141.             set ar($name) $val
  142.             }
  143.         } else {
  144.             set ar($name) $val
  145.         }
  146.         } else {
  147.         # multiple selection
  148.         lappend ar($name) $val
  149.         }
  150.     }
  151.     }
  152. }
  153.  
  154.  
  155.  
  156.  
  157.  
  158.